home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbnets / cti_nets.bas next >
BASIC Source File  |  1996-06-12  |  16KB  |  381 lines
  1. Option Explicit
  2.  
  3. ' Copyright ⌐ 1993, 1994 by Computer Technologies, Inc. All rights reserved.
  4.  
  5. Declare Function WNetGetConnection Lib "User" (ByVal LocalDev As String, ByVal rmtname As String, buffsize As Integer) As Integer
  6. Declare Function WNetAddConnection Lib "User" (ByVal NetPath As String, ByVal PassWord As String, ByVal LocalDev As String) As Integer
  7. Declare Function WNetCancelConnection Lib "User" (ByVal LocalDev As String, ByVal Force As Integer) As Integer
  8. Declare Function WNetGetUser Lib "User" (ByVal szUser As String, lpnBufferSize As Integer) As Integer
  9. Declare Function WNetGetCaps Lib "User" (ByVal nFlags As Integer) As Integer
  10. Declare Function MNetNetworkEnum Lib "WFWNET.DRV" (lpnSubnet As Integer) As Integer
  11. Declare Function MNetSetNextTarget Lib "WFWNET.DRV" (ByVal lpnSubnet As Integer) As Integer
  12.  
  13. Global Const WN_SUCCESS = &H0
  14. Global Const WN_NOT_SUPPORTED = &H1
  15. Global Const WN_NET_ERROR = &H2
  16. Global Const WN_MORE_DATA = &H3
  17. Global Const WN_BAD_POINTER = &H4
  18. Global Const WN_BAD_VALUE = &H5
  19. Global Const WN_BAD_PASSWORD = &H6
  20. Global Const WN_ACCESS_DENIED = &H7
  21. Global Const WN_FUNCTION_BUSY = &H8
  22. Global Const WN_WINDOWS_ERROR = &H9
  23. Global Const WN_BAD_USER = &HA
  24. Global Const WN_OUT_OF_MEMORY = &HB
  25. Global Const WN_CANCEL = &HC
  26. Global Const WN_CONTINUE = &HD
  27. Global Const WN_NOT_CONNECTED = &H30
  28. Global Const WN_OPEN_FILES = &H31
  29. Global Const WN_BAD_NETNAME = &H32
  30. Global Const WN_BAD_LOCALNAME = &H33
  31. Global Const WN_ALREADY_CONNECTED = &H34
  32. Global Const WN_DEVICE_ERROR = &H35
  33. Global Const WN_CONNECTION_CLOSED = &H36
  34.  
  35. ' Open file handling constants
  36. Global Const NET_OPENDISALLOW = 1
  37. Global Const NET_OPENQUERY = 2
  38. Global Const NET_OPENIGNORE = 3
  39.  
  40. Function UT_GetNetworkType () As String
  41.  
  42. ' Copyright ⌐ 1994 by Computer Technologies, Inc. All rights reserved.
  43.  
  44. ' When WNetGetCaps is called with the flag WNNC_NET_TYPE it returns a
  45. ' network type bit mask. The high byte contains the network type, and
  46. ' the low byte may contain a subtype. The network type can be one of
  47. ' the following values:
  48.     Const WNNC_NET_NONE = &H0
  49.     Const WNNC_NET_MSNet = &H100
  50.     Const WNNC_NET_LanMan = &H200
  51.     Const WNNC_NET_NetWare = &H300
  52.     Const WNNC_NET_Vines = &H400
  53.     Const WNNC_NET_10NET = &H500
  54.     Const WNNC_NET_Locus = &H600
  55.     Const WNNC_NET_SunPCNFS = &H700
  56.     Const WNNC_NET_LANstep = &H800
  57.     Const WNNC_NET_9TILES = &H900
  58.     Const WNNC_NET_LANtastic = &HA00
  59.     Const WNNC_NET_AS400 = &HB00
  60.     Const WNNC_NET_FTP_NFS = &HC00
  61.     Const WNNC_NET_PATHWORKS = &HD00
  62.     Const WNNC_NET_LifeNet = &HE00
  63.     Const WNNC_NET_POWERLan = &HF00
  64.     Const WNNC_NET_MultiNet = &H8000
  65.  
  66.     Const WNNC_SUBNET_NONE = &H0
  67.     Const WNNC_SUBNET_MSNet = &H1
  68.     Const WNNC_SUBNET_LanMan = &H2
  69.     Const WNNC_SUBNET_WinWork = &H4
  70.     Const WNNC_SUBNET_NetWare = &H8
  71.     Const WNNC_SUBNET_Vines = &H10
  72.     Const WNNC_SUBNET_Other = &H80
  73.  
  74.     Const WNNC_NET_TYPE = &H2
  75.     
  76.     Dim tTempStr            As String
  77.     Dim nFlags              As Integer
  78.     Dim nByteHi             As Integer
  79.     Dim nByteLo             As Integer
  80.  
  81.     tTempStr = ""
  82.  
  83.     nFlags = WNetGetCaps(WNNC_NET_TYPE)     ' Get network type bit flags
  84.  
  85.     If (nFlags And WNNC_NET_NONE) Then tTempStr = "Network not installed or not running" & ", "
  86.     If (nFlags And WNNC_NET_MSNet) Then tTempStr = "MSNet" & ", "
  87.     If (nFlags And WNNC_NET_LanMan) Then tTempStr = "LanMan" & ", "
  88.     If (nFlags And WNNC_NET_NetWare) Then tTempStr = "NetWare" & ", "
  89.     If (nFlags And WNNC_NET_Vines) Then tTempStr = "Vines" & ", "
  90.     If (nFlags And WNNC_NET_10NET) Then tTempStr = "10 NET" & ", "
  91.     If (nFlags And WNNC_NET_Locus) Then tTempStr = "Locus" & ", "
  92.     If (nFlags And WNNC_NET_SunPCNFS) Then tTempStr = "Sun PC NFS" & ", "
  93.     If (nFlags And WNNC_NET_LANstep) Then tTempStr = "LANstep" & ", "
  94.     If (nFlags And WNNC_NET_9TILES) Then tTempStr = "9 TILES" & ", "
  95.     If (nFlags And WNNC_NET_LANtastic) Then tTempStr = "LANtastic" & ", "
  96.     If (nFlags And WNNC_NET_AS400) Then tTempStr = "AS-400" & ", "
  97.     If (nFlags And WNNC_NET_FTP_NFS) Then tTempStr = "FTP NFS" & ", "
  98.     If (nFlags And WNNC_NET_PATHWORKS) Then tTempStr = "PATHWORKS" & ", "
  99.     If (nFlags And WNNC_NET_LifeNet) Then tTempStr = "LifeNet" & ", "
  100.     If (nFlags And WNNC_NET_POWERLan) Then tTempStr = "POWERLan" & ", "
  101.     If (nFlags And WNNC_NET_MultiNet) Then  ' Multinet is a bit mask that identifies all the sub nets so check each one ...
  102.     If (nFlags And WNNC_SUBNET_NONE) Then tTempStr = tTempStr & "None" & ", "
  103.     If (nFlags And WNNC_SUBNET_MSNet) Then tTempStr = tTempStr & "MsNet" & ", "
  104.     If (nFlags And WNNC_SUBNET_LanMan) Then tTempStr = tTempStr & "LanMan" & ", "
  105.     If (nFlags And WNNC_SUBNET_WinWork) Then tTempStr = tTempStr & "Windows for Workgroups" & ", "
  106.     If (nFlags And WNNC_SUBNET_NetWare) Then tTempStr = tTempStr & "NetWare" & ", "
  107.     If (nFlags And WNNC_SUBNET_Vines) Then tTempStr = tTempStr & "Vines" & ", "
  108.     If (nFlags And WNNC_SUBNET_Other) Then tTempStr = tTempStr & "Other" & ", "
  109.     End If
  110.  
  111.     If Right$(tTempStr, 2) = ", " Then tTempStr = Left$(tTempStr, Len(tTempStr) - 2)
  112.  
  113.     UT_GetNetworkType = tTempStr
  114.  
  115. End Function
  116.  
  117. Function UT_NetDismount (tLocalName As String, nOpenFileAction As Integer) As Integer
  118.  
  119. ' Copyright ⌐ 1993, 1994 by Computer Technologies, Inc. All rights reserved.
  120.  
  121. ' Inbound parameters:
  122. '   tLocalName          - The drive letter to dismount
  123. '   nOpenFileAction     - What to do if there are open files on the service
  124.  
  125. ' Use one of the following defined constants for nOpenFileAction values:
  126. '   NET_OPENDISALLOW    - Service can't be closed with open files
  127. '   NET_OPENQUERY       - Warn the user that there are open files
  128. '   NET_OPENIGNORE      - Ignore open files and force a dismount
  129.  
  130. ' Return value:
  131. '   True        - The service was dismounted
  132. '   False       - The service was NOT dismounted
  133.  
  134.     Dim nResult1            As Integer
  135.     Dim nResult2            As Integer
  136.     Dim nAction             As Integer
  137.     Dim bForceClose         As Integer
  138.     Dim tLocalDevice        As String
  139.     Dim tTempStr            As String
  140.  
  141. ' Change to uppercase and insure the correct format of the local drive letter
  142.     tLocalDevice = UCase$(Left$(tLocalName, 1)) & ":"
  143.  
  144. ' Setup for open file handling
  145.     If nOpenFileAction = NET_OPENIGNORE Then    ' Always dismount
  146.     bForceClose = True
  147.       Else                                      ' Disallow or Warn specified
  148.     bForceClose = False
  149.     End If
  150.  
  151. ' Attempt to drop the connection ...
  152. DismAttempt:
  153.     nResult1 = WNetCancelConnection(tLocalDevice, bForceClose)
  154.     
  155. ' Evaluate the return status of the disconnect
  156.     Select Case nResult1
  157.     Case WN_SUCCESS
  158.         UT_NetDismount = True
  159.     Case WN_OPEN_FILES
  160.         If nOpenFileAction = NET_OPENDISALLOW Then
  161.         MsgBox "There are still open files on the service and it cannot be disconnected. Please close the open files and click 'OK' to dismount the service.", 0, "Network Services"
  162.         GoTo DismAttempt
  163.         End If
  164.         If nOpenFileAction = NET_OPENQUERY Then      ' Warn and prompt
  165.         nAction = MsgBox("There are still open files on the service. Do you want to disconnect anyway?", 4 + 32, "Network Services")
  166.         If nAction = 6 Then                     ' Yes selected
  167.             bForceClose = True
  168.             GoTo DismAttempt
  169.           Else                                  ' No selected
  170.             UT_NetDismount = False
  171.         End If
  172.         End If
  173.     Case Else
  174.         tTempStr = UT_NetError(nResult1)
  175.         MsgBox "An unexpected network error has occurred: " & tTempStr, MB_ICONSTOP, "Network Error"
  176.         UT_NetDismount = False
  177.     End Select
  178.  
  179. End Function
  180.  
  181. Function UT_NetError (nErrorCode As Integer) As String
  182.  
  183. ' Copyright ⌐ 1993, 1994 by Computer Technologies, Inc. All rights reserved.
  184.  
  185. ' This function is passed the network error from a WNet* API function.
  186. ' The return string is the text form of the error.
  187.  
  188.     Dim tMessageText        As String
  189.  
  190.     Select Case nErrorCode
  191.     Case WN_NOT_SUPPORTED:      tMessageText = "Function is not supported."
  192.     Case WN_OUT_OF_MEMORY:      tMessageText = "Out of memory."
  193.     Case WN_NET_